;(defpackage social
;  (:use common-lisp))

;(in-package social)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simulation Parameters (those found in official spec)
;; Some of these will be varied in round two (melee) and possibly in round one!
;; Initial values were ass-pulled.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Probability of a payoff changing, or the average proportion of payoffs that will change per round.
;; This value will be held constant for the round-robin, but will vary in the melee.
;; The range is [0.001 - 0.4]
(defparameter *p-payoff-change* 0.01)

;; The number of individuals sampled when playing OBSERVE.
;; The range is [1 - 6]
(defparameter *n-observe* 1)

;; The probability that "The behavioral act returned by OBSERVE will not be that performed
;;                       by the observed individual, but rather an act selected at random."
;; The range is [0 - 0.5]
(defparameter *p-observe-wrong-act* 0.01)

;; The standard deviation of the error for observed payoffs, a normally distributed
;; variable with a mean of 0. If observed payoff is less than 0 as a result, 
;; it will be rounded to 0.
;; The range is [0 - 10]
(defparameter *sd-observe-payoff-error* 3)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simulation Constants - Fundamental (spec does not suggest that these will ever be varied.)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Probability of mutation per simulation round. 
;; Mutation is switched off in the last quarter of a melee round.
(defconstant +p-mutation+ 0.02)

;; Size of the "focal deme" population.
(defconstant +n-focal-population+ 100)

;; These are the magic numbers for the pairwise tournaments:

;; Number of rounds given for the dominant strategy to establish behavioral repertoires, 
;; before the mutants invade.
(defconstant +pairwise-rounds-debut+ 100)

;; Number of rounds for the mutant battle to continue, with new mutations allowed
(defconstant +pairwise-rounds-mittelspiel+ 7500)

;; Number of rounds for the last segment of a pairwise tournament, with no mutation allowed
;; This is also the period during which the mean frequency of each strategy is assessed;
;; this number will be averaged over the 20 reps, and used as the strategy's total pairwise score.
(defconstant +pairwise-rounds-endspiel+ 2500) ;; this gives a total of 10,000 as per the spec

;; Number of times each pairwise tournament is repeated with each strategy as the invader
(defconstant +pairwise-reps-with-each-as-invader+ 10)

;; The number of pairwise tournament winners who will advance to the melee round.
(defconstant +top-n-advancing-to-melee+ 10) ;; this makes a total of 20 repetitions


;; These are the magic numbers for the melee tournaments:

;; The number of rounds in the melee during which mutation is allowed.
(defconstant +melee-rounds-with-mutation+ 7500)

;; The number of rounds in the melee during which mutation is not allowed, and the score is kept
;; (in the same way as in the pairwise tournament.)
(defconstant +melee-rounds-no-mutation+ 7500)

;; The number of rounds the melee will repeat, *FOR EACH SET OF PARAMETERS*.
;; The strategy with the highest average score will be declared the final winner.
(defconstant +melee-reps+ 100)


;; General magic numbers - so as not to hardcode anything.

;; The number of possible acts. There is no reason to ever change this.
(defconstant +available-acts+ 100)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Simulation Constants - Non-Fundamental (spec is silent on these)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Maximum payoff in all simulations
(defconstant +max-payoff-normal+ 100)

;; Maximum payoff for the bottom part of the skewed (bottom-heavy) payoff distribution
(defconstant +max-payoff-skewed-bottom+ 10)

;; Maximum payoff for the top part of the skewed (bottom-heavy) payoff distribution
(defconstant +max-payoff-skewed-top+ 100)

;; Probability of a payoff ending up in the bottom part of the skewed distribution
(defconstant +p-skewed-bottom+ 0.9)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Randomness
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro with-probability (p event &optional altern)
  "Return 'event' with probability 'p', else optional 'altern'."
  `(if (<= (random 1.0) ,p)
      ,event
      ,altern))


;; "Skewed"
(defun random-payoff ()
  "Generate a random payoff for an act, using a skewed (bottom-heavy) distribution."
  (with-probability +p-skewed-bottom+
    (random +max-payoff-skewed-bottom+)
    (random +max-payoff-skewed-top+)))

;; Which statistical distrubution to use for new random payoffs?
;; Spec: "...distribution with many relatively small payoffs and
;;        some relatively large ones." (section 1.1.1)

;; Pick a random element from a sequence of any kind.
;; Later we can optimize this (and other functions) for speed with simple-vectors.
(defun random-pick (choices)
  "Choose an element from a sequence at random."
  (elt choices (random (length choices))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Generic Useful Things
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro with-gensyms (syms &body body)
  "Classic macro from PG."
  `(let (,@(mapcar (lambda (sym) `(,sym (gensym ,(symbol-name sym)))) syms))
     ,@body))

(defmacro vector-do (vec var &body body)
  "Iterates across a simple-vector, through an assignable 'var'."
  (with-gensyms (n)
    `(symbol-macrolet ((,var (svref ,vec n)))
       (dotimes (n (length ,vec))
	 ,@body))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The Simulation: Dealer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; All of the strategies currently in play.
(defvar %strategies-in-play% NIL)

;;;;;;;;;;;;;; DEBUG ;;;;;;;;;;;;;;;;;;;;
;; Creature serial numbers
(defvar %creature-serial% 0)
;;;;;;;;;;;;;; DEBUG ;;;;;;;;;;;;;;;;;;;;

;; The population of creatures currently in play.
(defvar %creatures-in-play%)

;; The current payoff matrix.
(defvar %current-payoffs%
  (make-array +available-acts+ :initial-element 0))

(defun refresh-payoffs (p)
  "Update each of the current payoffs, with probability 'p'."
  (vector-do %current-payoffs% payoff
    (with-probability p
      (setf payoff (random-payoff)))))





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The Simulation: Player
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; (defclass creature ()
;;   ((rounds-alive  :accessor creature-rounds-alive
;; 		  :initform 0)
;;    (my-repertoire :accessor creature-repertoire
;; 		  :initform (make-array +available-acts+ :initial-element NIL))))


;; (defstruct (creature
;; 	     (:conc-name c-)
;; 	     (:print-function print-creature)
;; 	     ; apparently this can't co-exist with printability. let's put it back when everything works.
;; 	     ; (:type vector)
;; 	     )
;;   "A creature: a given individual in the simulation."
;;   ; Legally accessable by creature:
;;   ; number of rounds the creature has been in play.
;;   (rounds-alive 0)
;;   ; The repertoire of acts available to the creature. Initially none (unknown payoff represented as -1)
;;   ;(repertoire (make-array +available-acts+ :initial-element -1))
;;   (repertoire NIL)
;;   ; The creature's move history.
;;   (history NIL)
;;   ; --------------------------------------------------------------------------------------------
;;   ; For use by the dealer:
;;   ; Strategy used by this creature.
;;   (strategy NIL)
;;   ; The creature's serial number. Each one created has a unique one, for debug purposes.
;;   ; Eventually remove this feature for speed.
;;   (serial-number (incf %creature-serial%))
;;   )

;; (defun print-creature (creature stream depth)
;;   "Print a creature for display: serial number and stats."
;;   (format stream "#<Creature ~D>" (c-serial-number creature)))


;; (defstruct (strategy
;; 	     (:type vector))
;;   "A play strategy."
;;   (name "Default. Simple Asocial Learner: INNOVATE once, then EXPLOIT forever.")
;;   (stats NIL) ; flesh this out
;;   ; Actual algorithm for the strategy's play. This is the part that is of interest.
;;   (play #'default-strategy-play))
  

;; (defmacro defstrategy (name &body body)
;;   "Defines a strategy and puts it into play."
;;   `(defun ,name (creature)
;;      (let ((rounds-alive (c-rounds-alive creature))
;; 	   (my-repertoire (c-repertoire creature))
;; 	   (my-history (c-history creature)))
;;        ,@body)))

;; (defstrategy default-strategy-play
;;   (if (= rounds-alive 0)
;;       'INNOVATE
;;       (

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; (defun default-strategy ()
;; ;;  (declare (special rounds-alive))
;;   (incf rounds-alive))


;; (defun make-creature (strategy)
;;   "Create a creature, given a strategy for it to use."
;; ;;  (declare (special rounds-alive))
;;   (let ((my-strategy strategy)
;; 	(rounds-alive 0)
;; 	(my-repertoire NIL)
;; 	(my-history NIL)
;; 	(serial-number (incf %creature-serial%)))
;;     #'(lambda (operation &rest arguments)
;; 	(ecase operation
;; 	  (move
;; 	   '|MOVE-MADE|)
;; 	  (advance
;; 	   (incf rounds-alive))
;; 	  (splat
;; 	   (funcall my-strategy))))))

(defmacro defstrategy (name &body body)
  "Defines a strategy and puts it into play."
  `(defun ,name (creature)
    ,@body))


(defun create-obi ()
  (let ((h (make-hash-table)))
    (lambda (command field &optional value) 
      (case command
        (get (gethash field h))
        (set (setf (gethash field h) value))
        (run (apply (gethash field h) value))))))

